home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / error.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  3.7 KB  |  152 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: error.c,v 1.10 94/11/29 06:41:29 wlott Exp $
  27. *
  28. * This file implements the stuff to signal errors from C code.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "str.h"
  36. #include "thread.h"
  37. #include "module.h"
  38. #include "sym.h"
  39. #include "list.h"
  40. #include "vec.h"
  41. #include "type.h"
  42. #include "def.h"
  43. #include "bool.h"
  44. #include "obj.h"
  45. #include "print.h"
  46. #include "func.h"
  47. #include "driver.h"
  48.  
  49. static boolean error_system_enabled = FALSE;
  50.  
  51. static struct variable *error_var = NULL;
  52. static struct variable *type_error_var = NULL;
  53.  
  54. static void verror(char *msg, va_list ap)
  55. {
  56.     int nargs = count_format_args(msg);
  57.     int i;
  58.     struct thread *thread = thread_current();
  59.     
  60.     if (error_system_enabled) {
  61.     *thread->sp++ = error_var->value;
  62.     *thread->sp++ = make_byte_string(msg);
  63.     for (i = 0; i < nargs; i++)
  64.         *thread->sp++ = va_arg(ap, obj_t);
  65.  
  66.     invoke(thread, nargs+1);
  67.     go_on();
  68.     }
  69.     else if (thread) {
  70.     obj_t cond = make_vector(nargs+1, NULL);
  71.  
  72.     SOVEC(cond)->contents[0] = make_byte_string(msg);
  73.     for (i = 1; i <= nargs; i++)
  74.         SOVEC(cond)->contents[i] = va_arg(ap, obj_t);
  75.  
  76.     thread_debuggered(thread, cond);
  77.     }
  78.     else {
  79.     obj_t cond = make_vector(nargs, NULL);
  80.  
  81.     for (i = 0; i < nargs; i++)
  82.         SOVEC(cond)->contents[i] = va_arg(ap, obj_t);
  83.     
  84.     printf("error: ");
  85.     vformat(msg, SOVEC(cond)->contents, nargs);
  86.     putchar('\n');
  87.     exit(1);
  88.     }
  89. }
  90. #if _USING_PROTOTYPES_
  91. void error(char *msg, ...)
  92. {
  93.     va_list ap;
  94.     va_start(ap, msg);
  95.     verror(msg, ap);
  96.     va_end(ap);
  97. }
  98. #else
  99. void error(va_alist) va_dcl
  100. {
  101.     va_list ap;
  102.     char *msg;
  103.     
  104.     va_start(ap);
  105.     msg = va_arg(ap, char *);
  106.     verror(msg, ap);
  107.     va_end(ap);
  108. }
  109. #endif
  110.  
  111. void type_error(obj_t value, obj_t type)
  112. {
  113.     if (error_system_enabled) {
  114.     struct thread *thread = thread_current();
  115.     *thread->sp++ = type_error_var->value;
  116.     *thread->sp++ = value;
  117.     *thread->sp++ = type;
  118.     invoke(thread, 2);
  119.     go_on();
  120.     }
  121.     else
  122.     error("%= is not an instance of type %=", value, type);
  123. }
  124.  
  125. obj_t check_type(obj_t thing, obj_t type)
  126. {
  127.     if (!instancep(thing, type)) {
  128.     type_error(thing, type);
  129.     /* Never reached, but keeps the compiler happy. */
  130.     return 0;
  131.     }
  132.     else
  133.     return thing;
  134. }
  135.  
  136. static obj_t enable_error_system(void)
  137. {
  138.     error_system_enabled = TRUE;
  139.     return obj_True;
  140. }
  141.  
  142. void init_error_functions(void)
  143. {
  144.     define_function("enable-error-system", obj_Nil, FALSE, obj_False, FALSE,
  145.             obj_ObjectClass, enable_error_system);
  146.     error_var = find_variable(module_BuiltinStuff, symbol("error"),
  147.                   FALSE, TRUE);
  148.     type_error_var = find_variable(module_BuiltinStuff, symbol("type-error"),
  149.                    FALSE, TRUE);
  150. }
  151.  
  152.